home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / fpl-v13.lha / fpl / src / script.c < prev    next >
C/C++ Source or Header  |  1995-08-22  |  70KB  |  2,426 lines
  1. /******************************************************************************
  2.  *              FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  script.c
  6.  
  7.  The main routine of the language. Handles all keywords, {'s and }'s.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <libraries/dos.h>
  44. #include <proto/dos.h>
  45.  
  46. #include <exec/libraries.h>
  47. #include <dos.h>
  48.  
  49. #elif defined(UNIX)
  50. #include <sys/types.h>
  51. #include <sys/stat.h>
  52. #include <stdlib.h>
  53. #endif
  54.  
  55. #include <stdio.h>
  56. #include <string.h>
  57. #include "script.h"
  58. #include "debug.h"
  59.  
  60. #ifdef DEBUG
  61. long mem=0;
  62. long maxmem=0;
  63. #endif
  64.  
  65. static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
  66.                     uchar *, long, uchar *);
  67. static uchar REGARGS CheckIt(struct Data *, struct Expr *, short, ReturnCode *);
  68. static ReturnCode INLINE Declare(struct Expr *, struct Data *,
  69.                  struct Identifier *, long);
  70. static ReturnCode Go(struct Data *, struct Expr *val);
  71. static ReturnCode REGARGS Loop(struct Data *, struct Condition *, short, uchar *);
  72. static ReturnCode INLINE Resize(struct Data *, struct Expr *, uchar);
  73. static ReturnCode REGARGS SkipStatement(struct Data *);
  74. static ReturnCode REGARGS StoreGlobals(struct Data *, uchar);
  75. static ReturnCode REGARGS Run(struct Data *, uchar *, uchar *, long, unsigned long *);
  76. static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
  77.                                 struct Condition *);
  78. static REGARGS void StoreBeginning(struct Data *, char *, long);
  79. /*
  80.  * Global character flags:
  81.  */
  82.  
  83. const uchar type[257] = { /* Character type codes */
  84.    _C, /* -1 == regular ANSI C eof character */
  85.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 00        */
  86.    _C,    _S,      _S,     _C,    _C,    _S,    _C,    _C, /* 08        */
  87.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 10        */
  88.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 18        */
  89.    _S,    _P,     _P,     _P,    _P,    _P,    _P,    _P, /* 20    !"#$%&' */
  90.    _P,    _P,     _P,    _P,    _P,    _P,    _P,    _P, /* 28 ()*+,-./ */
  91.  _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, /* 30 01234567 */
  92.  _N|_X, _N|_X,    _P,    _P,    _P,    _P,    _P,    _P, /* 38 89:;<=>? */
  93.    _P, _U|_X,  _U|_X, _U|_X, _U|_X, _U|_X, _U|_X,    _U, /* 40 @ABCDEFG */
  94.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 48 HIJKLMNO */
  95.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 50 PQRSTUVW */
  96.    _U,    _U,      _U,     _P,    _P,    _P,    _P, _P|_W, /* 58 XYZ[\]^_ */
  97.    _P, _L|_X,  _L|_X, _L|_X, _L|_X, _L|_X, _L|_X,    _L, /* 60 `abcdefg */
  98.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 68 hijklmno */
  99.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 70 pqrstuvw */
  100.    _L,    _L,      _L,     _P,    _P,    _P,    _P,   000, /* 78 xyz{|}~    */
  101.   000,   000,     000,    000,   000,   000,   000,   000, /* 80             */
  102.   000,   000,     000,    000,   000,   000,   000,   000, /* 88             */
  103.   000,   000,     000,    000,   000,   000,   000,   000, /* 90             */
  104.   000,   000,     000,    000,   000,   000,   000,   000, /* 98             */
  105.   000,   000,     000,    000,   000,   000,   000,   000, /* A0             */
  106.   000,   000,     000,    000,   000,   000,   000,   000, /* A8             */
  107.   000,   000,     000,    000,   000,   000,   000,   000, /* B0             */
  108.   000,   000,     000,    000,   000,   000,   000,   000, /* B8             */
  109.   000,   000,     000,    000,   000,   000,   000,   000, /* C0             */
  110.   000,   000,     000,    000,   000,   000,   000,   000, /* C8             */
  111.   000,   000,     000,    000,   000,   000,   000,   000, /* D0             */
  112.   000,   000,     000,    000,   000,   000,   000,   000, /* D8             */
  113.   000,   000,     000,    000,   000,   000,   000,   000, /* E0             */
  114.   000,   000,     000,    000,   000,   000,   000,   000, /* E8             */
  115.   000,   000,     000,    000,   000,   000,   000,   000, /* F0             */
  116.   000,   000,     000,    000,   000,   000,   000,   000, /* F8             */
  117. };
  118.  
  119.  
  120. #ifndef AMIGA /* if not using SAS/C on Amiga */
  121.  
  122. /******************************************************/
  123. /* Parameter list frontends of the library functions: */
  124. /******************************************************/
  125.  
  126. #ifdef VARARG_FUNCTIONS
  127. long fplExecuteFileTags(void *anchor, uchar *program, ...)
  128. {
  129.   va_list tags;
  130.   long ret;
  131.   va_start(tags, program); /* get parameter list */
  132.   ret = fplExecuteFile(anchor, program, (unsigned long *)tags);
  133.   va_end(tags)
  134.   return ret;
  135. }
  136. #else /* VARARG_FUNCTIONS */
  137. long fplExecuteFileTags(void *anchor, uchar *program, unsigned long tags, ...)
  138. {
  139.   return(fplExecuteFile(anchor, program, (unsigned long *)&tags));
  140. }
  141. #endif
  142.  
  143. #endif
  144.  
  145. /***************************************************************************
  146.  *
  147.  * fplExecuteFile()
  148.  *
  149.  * Executes the specified file as an FPL program.
  150.  *
  151.  ******/
  152.  
  153. ReturnCode PREFIX fplExecuteFile(AREG(0) struct Data *scr,
  154.                  AREG(1) uchar *filename,
  155.                  AREG(2) unsigned long *tags)
  156. {
  157. #ifdef DEBUGMAIL
  158.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteFile");
  159. #endif
  160.   return(Run(scr, filename, NULL, 1, tags));
  161. }
  162.  
  163.  
  164. #ifndef AMIGA /* if not using SAS/C on Amiga */
  165.  
  166. #ifdef VARARG_FUNCTIONS
  167. long fplExecuteScriptTags(void *anchor, uchar **program, long lines, ...)
  168. {
  169.   va_list tags;
  170.   long ret;
  171.   va_start(tags, lines); /* get parameter list */
  172.   ret = fplExecuteScript(anchor, program, lines, (unsigned long *)tags);
  173.   va_end(tags)
  174.   return ret;
  175. }
  176. #else /* VARARG_FUNCTIONS */
  177.  
  178. long fplExecuteScriptTags(void *anchor, uchar **program, long lines,
  179.                           unsigned long tags, ...)
  180. {
  181.   return(fplExecuteScript(anchor, program, lines, (unsigned long *)&tags));
  182. }
  183. #endif
  184.  
  185. #endif
  186.  
  187. /**********************************************************************
  188.  *
  189.  * fplExecuteScript()
  190.  *
  191.  * Frontend to Run().
  192.  *
  193.  * The error code is returned to daddy...
  194.  *
  195.  ******/
  196.  
  197. ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
  198.                    AREG(1) uchar **program, /* program array */
  199.                    DREG(1) long lines,     /* number of lines */
  200.                    AREG(2) unsigned long *tags)
  201. {
  202. #ifdef DEBUGMAIL
  203.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteScript");
  204. #endif
  205.   return(Run(scr, NULL, *program, lines, tags));
  206. }
  207.  
  208.  
  209. /**************************************************************************
  210.  *
  211.  * ReadFile()
  212.  *
  213.  *   Reads the specified file into memory, stores the pointer to the memory
  214.  * area in the pointer `program' points to, and the size of the memory area
  215.  * in the integer `size' points to. I decided to use a different way on Amiga
  216.  * to increase performance a lot.
  217.  *
  218.  *   This function first checks the size of the file it's about to fetch
  219.  * and then reads the entire file at once in one continuos memory area.
  220.  *
  221.  *   Returns the proper return code. If anything goes wrong, there won't be
  222.  * *ANY* program to look at (the pointer will be NULL, but the size will most
  223.  * probably still be correct which means a non-zero value). If this function
  224.  * fails it takes care of freeing the program memory by itself. You only have
  225.  * to free that memory if this functions reports success.
  226.  *
  227.  ********/
  228.  
  229. ReturnCode REGARGS
  230. ReadFile(void *fpl,
  231.          uchar *filename,
  232.          struct Program *prog)
  233. {
  234.   struct Data *scr=(struct Data *)fpl;
  235. #ifdef AMIGA  /* Amiga version. */
  236.   struct FileInfoBlock fileinfo;
  237.   struct FileLock *lock=NULL;
  238.   struct FileHandle *fileread;
  239.  
  240.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  241.   struct Library *DOSBase = lib->ml_DosBase;
  242. #elif defined(UNIX)
  243.   FILE *stream;
  244.   struct stat statstr;
  245. #endif
  246.   ReturnCode ret=FPL_OK;
  247. #ifdef AMIGA
  248.  
  249.   if(filename && filename[0])
  250.     /* Lock on file */
  251.     lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ);
  252.   if (lock) {
  253.     if (Examine((BPTR)lock, &fileinfo) && fileinfo.fib_Size) {
  254.       /*
  255.        * Only do this if the file was there, and it was larger than zero
  256.        * bytes!
  257.        */
  258.       prog->size = fileinfo.fib_Size+1; /* Add one for a terminating zero! */
  259.     } else
  260.       ret=FPLERR_OPEN_ERROR;    /* something went wrong */
  261.     UnLock((BPTR)lock);    /* release the lock of the file */
  262.   } else
  263.     ret=FPLERR_OPEN_ERROR;        /* we couldn't lock on the file */
  264. #elif defined(UNIX)
  265.   if (!(stream = fopen(filename, "r")))
  266.     ret=FPLERR_OPEN_ERROR;
  267.   else {
  268.     if(fseek(stream, 0, 2)) {
  269.       fclose(stream);
  270.       ret=FPLERR_OPEN_ERROR;
  271.     } else {
  272.       prog->size=ftell(stream)+1;
  273.       fseek(stream, 0, 0);
  274.     }
  275.   }
  276. #endif
  277.  
  278. #ifdef AMIGA
  279.   prog->date = GETFILEDATE(fileinfo);
  280. #else
  281.   if(!stat(filename, &statstr)) {
  282.     prog->date = statstr.st_mtime;
  283.   } else
  284.     ret=FPLERR_OPEN_ERROR;
  285. #endif
  286.  
  287.   if(ret)
  288.     return(ret);
  289.  
  290.   /* Open file for reading. */
  291. #ifdef AMIGA
  292.   /* We could use OpenFromLock() here, but it's a V36+ function! */
  293.   fileread=(struct FileHandle *)Open((UBYTE *)filename, MODE_OLDFILE);
  294. #elif defined(UNIX)
  295.   /* file is already opened! */
  296. #endif
  297.   prog->program=(uchar *)MALLOC(prog->size); /* Allocate memory for program. */
  298.   if(!prog->program) /* if we didn't get the requested memory: */
  299.     ret=FPLERR_OUT_OF_MEMORY;
  300. #ifdef AMIGA
  301.   else if(Read((BPTR)fileread, prog->program, (LONG)prog->size)<0) /* get entire file */
  302. #elif defined(UNIX)
  303.   else if(!fread(prog->program, 1, prog->size, stream))
  304. #endif
  305.     /* if we couldn't Read() the file: */
  306.     ret=FPLERR_OPEN_ERROR;
  307.   else
  308.     (prog->program)[prog->size-1]='\0'; /* add the terminating zero byte. */
  309. #ifdef AMIGA
  310.   Close((BPTR)fileread); /* close file */
  311. #elif defined(UNIX)
  312.   fclose(stream); /* close the stream */
  313. #endif
  314.   /* only if error and we could allocate the proper memory */
  315.   if(ret && prog->program) {
  316.     FREE(prog->program); /* free the, for the program allocated, memory */
  317.   }
  318.   return(ret); /* get back to parent */
  319. }
  320.  
  321. /**********************************************************************
  322.  *
  323.  * AddProgram();
  324.  *
  325.  * Adds a program to FPL's internal lists of program files.
  326.  *
  327.  ****/
  328.  
  329. static ReturnCode INLINE AddProgram(struct Data *scr,
  330.                     struct Program **get,
  331.                     uchar *program,
  332.                     long lines,
  333.                     uchar *name)
  334. {
  335.   struct Program *next, *prog=NULL;
  336.   ReturnCode ret;
  337.   long date=-1;
  338. #ifdef AMIGA
  339.   struct FileLock *lock;
  340.   struct FileInfoBlock fileinfo;
  341.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  342.   struct Library *DOSBase = lib->ml_DosBase;
  343. #else
  344.   struct stat statstr;
  345. #endif
  346.   if(name && name[0]) {
  347.     /*
  348.      * Name was given. Search through the internals to see if
  349.      * we have this file cached already!
  350.      */
  351.     prog=scr->programs;
  352.     while(prog) {
  353.       if(!strcmp(prog->name, name))
  354.     break;
  355.       prog=prog->next;
  356.     }
  357.   }
  358.   if(prog) {
  359.  
  360.     /*
  361.      * The program already exists.
  362.      */
  363.     if( (prog->flags & PR_REREAD_CHANGES) &&
  364.         (prog->flags & PR_NAME_IS_FILENAME) &&
  365.         !(prog->flags&PR_USERSUPPLIED) ) {
  366. #ifdef AMIGA
  367.       if (lock=(struct FileLock *)Lock((UBYTE *)prog->name, ACCESS_READ)) {
  368.         if (Examine((BPTR)lock, &fileinfo))
  369.           date = GETFILEDATE(fileinfo);
  370.         UnLock((BPTR)lock);
  371.       }
  372. #else
  373.       if(!stat(prog->name, &statstr)) {
  374.     date = statstr.st_mtime;
  375.       }
  376. #endif
  377.       /* Compare dates of internal program and actual file */
  378.       if(date != prog->date) {
  379.         /*
  380.          * The dates are different, flush all info that has to do with the
  381.          * file, and re-read it into memory!
  382.          */
  383.         unsigned long tags[]={FPLSEND_FREEFILE, NULL, FPLSEND_DONE};
  384.         tags[1] = (unsigned long)prog->name;
  385.         CALL(Send(scr, tags));
  386.         prog=NULL; /* force a insertion of this file again! */
  387.       }
  388.     }
  389.  
  390.     /*
  391.      * The very same good old program. If the FPLTAG_PREVENT_RUNNING_SAME
  392.      * was used, then abort here and now!
  393.      */
  394.     if(prog && scr->flags&FPLDATA_PREVENT_RUNNING_SAME) {
  395.       *get = NULL;
  396.       return FPL_OK;
  397.     }
  398.  
  399. /*
  400.  
  401.   These following actions don't have to be done!
  402.  
  403.     CALL(LeaveProgram(scr, scr->prog));
  404.     CALL(GetProgram(scr, prog));
  405. */
  406.   }
  407.  
  408.   if(!prog) {
  409.     GETMEMA(prog, sizeof(struct Program));
  410.     memset(prog, 0, sizeof(struct Program));
  411. #ifdef DEBUG
  412.     CheckMem(scr, prog);
  413. #endif
  414.     next=scr->programs;
  415.     prog->next=next;
  416.     prog->program=program;
  417.     prog->lines=lines;
  418.     prog->startprg=1;
  419.     prog->virprg=1;
  420.     prog->flags = (scr->flags&FPLDATA_REREAD_CHANGES?
  421.                     PR_REREAD_CHANGES:0)|
  422.                   (scr->flags&FPLDATA_FLUSH_NOT_IN_USE?
  423.                     PR_FLUSH_NOT_IN_USE:0)|
  424.           (scr->flags&FPLDATA_KIDNAP_CACHED?
  425.             PR_KIDNAP_CACHED:0);
  426.     if(name) {
  427.       STRDUPA(prog->name, name);
  428.     }
  429.     scr->programs=prog;
  430.   }
  431.  
  432.   scr->prog=prog;
  433.   *get=prog;
  434.   return(FPL_OK);
  435. }
  436.  
  437. /**********************************************************************
  438.  *
  439.  * DelProgram()
  440.  *
  441.  * Deletes a specifed program from memory. If NULL is specified where
  442.  * the program struct is supposed, all programs are removed! (Amiga
  443.  * version *have* to do that to UnLock() all files that might be locked
  444.  * when using the FPLTAG_LOCKUSED!
  445.  *
  446.  *******/
  447.  
  448. ReturnCode REGARGS
  449. DelProgram(struct Data *scr,
  450.            struct Program *del)
  451. {
  452.   struct Program *prog=scr->programs, *prev=NULL;
  453.   while(prog) { /* it must not be running! */
  454.     if((!del || prog==del) && !prog->running) {
  455.       if(prev)
  456.     prev->next=prog->next;
  457.       else
  458.     scr->programs=prog->next;
  459.       if(scr->prog==del)
  460.     scr->prog=scr->prog->next;
  461.       prev=prog->next;
  462.       if(prog->name)
  463.     FREEA(prog->name);
  464.       if(!(prog->flags&PR_USERSUPPLIED) && prog->program) {
  465.         SwapMem(scr, prog->program, MALLOC_DYNAMIC);
  466.         FREE(prog->program);
  467.       }
  468.       FREEA(prog);
  469.       if(!del) {
  470.     prog=prev;
  471.     prev=NULL;
  472.       } else {
  473.     if(del)
  474.       break;
  475.       }
  476.     } else {
  477.       prev=prog;
  478.       prog=prog->next;
  479.     }
  480.   }
  481.   return(FPL_OK);
  482. }
  483.  
  484. /**********************************************************************
  485.  *
  486.  * Run()
  487.  *
  488.  *****/
  489.  
  490. static ReturnCode REGARGS
  491. Run(struct Data *scr,
  492.     uchar *filename,
  493.     uchar *program,
  494.     long lines,
  495.     unsigned long *tags)
  496. {
  497.   ReturnCode end;
  498.   struct Expr *val;
  499.   unsigned long *tag=tags;
  500.   uchar storeglobals;    /* DEFAULT: fplInit() value! */
  501.   struct Program *thisprog, *prog;
  502.   struct Store *store;
  503.   struct Local *glob;
  504.   long currcol;
  505.   long *globpointer=NULL;
  506.  
  507.   /* Store the 'soft' debugging information! */
  508.   long prev_mode = scr->flags & (FPLDATA_DEBUG_MODE|FPLDATA_ISOLATE);
  509.  
  510. #ifdef DEBUG
  511.   long memory=mem;
  512. #endif
  513.  
  514.   if(!scr)
  515.     /* misbehaviour */
  516.     return(FPLERR_ILLEGAL_ANCHOR);
  517.  
  518.   if(scr->runs) {
  519.     /* this is a nested call! */
  520.     GETMEM(store, sizeof(struct Store));
  521.  
  522.     currcol=scr->text-(&scr->prog->program)[scr->prg-1];
  523.  
  524.     LeaveProgram(scr, scr->prog);
  525.     memcpy(store, &scr->text, sizeof(struct Store));
  526.   } else {
  527.     scr->msg = NULL;  /* We start with an empty message queue! */
  528.     scr->varlevel =0; /* start at locale level 0 */
  529.   }
  530.   end = AddProgram(scr, &prog, program, lines, filename);
  531.  
  532.   if(NULL == prog && FPL_OK == end) {
  533.     /*
  534.      * This execution was simply prevented due to circumstances!
  535.      */
  536.   }
  537.   else if(end <= FPL_EXIT_OK) {
  538.  
  539.     if(!prog->program && filename) {
  540.       /*
  541.        * It didn't already exist.
  542.        */
  543.       end = ReadFile(scr, filename, prog); /* get file */
  544.       prog->flags|=PR_NAME_IS_FILENAME;
  545.     } else if(!filename)
  546.       prog->flags=PR_USERSUPPLIED;
  547.  
  548.     if(end <= FPL_EXIT_OK) {
  549.  
  550.       end=GetProgram(scr, prog); /* lock it for our use! */
  551.  
  552.       if(end <= FPL_EXIT_OK) {
  553.  
  554.         thisprog=scr->prog;
  555.         if(scr->flags&FPLDATA_CACHEALLFILES) {
  556.           thisprog->flags|=PR_CACHEFILE;
  557.           if(scr->flags&FPLDATA_CACHEEXPORTS)
  558.             thisprog->flags|=PR_CACHEEXPORTS;
  559.         } else
  560.           thisprog->flags&=~PR_CACHEFILE;
  561.  
  562.         thisprog->openings++;
  563.  
  564.         scr->prg=thisprog->startprg;     /* starting line number */
  565.         scr->text=(&thisprog->program)[thisprog->startprg-1]+
  566.           thisprog->startcol; /* execute point */
  567.  
  568.  
  569.     /* fprintf(stderr, "Exp:%s", scr->text); */
  570.  
  571.         scr->ret=FPL_OK;        /* return code reset */
  572.         scr->virprg=thisprog->virprg;    /* starting at right virtual line */
  573.         scr->virfile=thisprog->virfile;    /* starting at right virtual file */
  574.         scr->level=0;            /* level counter */
  575.         scr->strret=FALSE;        /* we don't want no string back! */
  576.         scr->interpret=NULL;        /* no interpret tag as default */
  577.         scr->locals=NULL;        /* local symbol list */
  578.         scr->globals=NULL;        /* global symbol list */
  579.         scr->FPLret=0;        /* initialize return code value */
  580.         scr->string_return=NULL;    /* no string returns allowed */
  581.  
  582.         while(tag && *tag) {
  583.           switch(*tag++) {
  584.           case FPLTAG_ISOLATE:
  585.         scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE, *tags);
  586.         break;
  587.  
  588.           case FPLTAG_DEBUG:
  589.         scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE, *tags);
  590.         break;
  591.  
  592.           case FPLTAG_REREAD_CHANGES:
  593.         thisprog->flags = BitToggle(thisprog->flags,
  594.                     PR_REREAD_CHANGES, *tags);
  595.             break;
  596.  
  597.           case FPLTAG_FLUSH_NOT_IN_USE:
  598.         thisprog->flags = BitToggle(thisprog->flags,
  599.                     PR_FLUSH_NOT_IN_USE, *tags);
  600.             break;
  601.  
  602.           case FPLTAG_KIDNAP_CACHED:
  603.         thisprog->flags = BitToggle(thisprog->flags,
  604.                     PR_KIDNAP_CACHED, *tags);
  605.             break;
  606.  
  607.           case FPLTAG_STRING_RETURN:
  608.             scr->string_return = (uchar **)*tag;
  609.             scr->strret=TRUE; /* enable return string */
  610.             break;
  611.  
  612.           case FPLTAG_INTERPRET:
  613.             scr->interpret=(uchar *)*tag;
  614.             break;
  615.  
  616.           case FPLTAG_STARTPOINT:
  617.             scr->text=(uchar *)*tag;
  618.             break;
  619.           case FPLTAG_STARTLINE:
  620.             scr->prg=(long)*tag;
  621.             break;
  622.           case FPLTAG_USERDATA:
  623.             scr->userdata=(void *)*tag;
  624.             break;
  625.           case FPLTAG_CACHEFILE:
  626.             if(*tag) {
  627.               thisprog->flags|=PR_CACHEFILE;
  628.               if(*tag=FPLCACHE_EXPORTS)
  629.                 thisprog->flags|=PR_CACHEEXPORTS;
  630.             } else
  631.               thisprog->flags&=~PR_CACHEFILE;
  632.             break;
  633.           case FPLTAG_PROGNAME:
  634.         if(*tag) {
  635.               prog=scr->programs;
  636.               while(prog) {
  637.                 if(prog->name && !strcmp(prog->name, (uchar *)*tag))
  638.                   break;
  639.                 prog=prog->next;
  640.               }
  641.               if(!prog) {
  642.                 /*
  643.                  * The program was not found, then set/rename the
  644.                  * current program to this name!
  645.                  */
  646.                 if(thisprog->name) {
  647.                   FREEA(thisprog->name);
  648.                 }
  649.                 STRDUPA(thisprog->name, *tag);
  650.               } else {
  651.                 /*
  652.                  * We found another progam with that name. Execute that
  653.                  * instead of this!
  654.                  */
  655.                 DelProgram(scr, thisprog);
  656.                 thisprog=prog;
  657.               }
  658.         }
  659.             break;
  660.           case FPLTAG_FILENAMEGET:
  661.         thisprog->flags = BitToggle(thisprog->flags,
  662.                     PR_FILENAMEFLUSH, *tags);
  663.             break;
  664.           case FPLTAG_ISCACHED:
  665.             globpointer = (long *)*tag;
  666.             break;
  667.           }
  668.           tag++;
  669.         }
  670.  
  671.         if(!thisprog->name) {
  672.           /* If no name has been given, do not store any global symbols from it! */
  673.           STRDUPA(thisprog->name, FPLTEXT_UNKNOWN_PROGRAM);
  674.           storeglobals=FALSE;
  675.           thisprog->flags&=~(PR_CACHEFILE|PR_CACHEEXPORTS);
  676.         } else
  677.           storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS);
  678.  
  679.         scr->virfile=thisprog->name; /* starting with this file */
  680.         val= MALLOC(sizeof(struct Expr));
  681.         if(val) {
  682.           end=Go(scr, val);
  683.           if(end<=FPL_EXIT_OK &&
  684.              scr->string_return) {
  685.             /*
  686.              * No error and
  687.              * we accept string returns and...
  688.              */
  689.             if((val->flags&(FPL_STRING|FPL_RETURN)) ==
  690.                (FPL_STRING|FPL_RETURN) &&
  691.                val->val.str) {
  692.               /*
  693.                * ...there was a final "return" or "exit" keyword.
  694.                * and we have a returned string to deal with.
  695.                */
  696.   
  697.               /* assign the pointer */
  698.               *scr->string_return = val->val.str->string;
  699.   
  700.               /* make it a "static" allocation */
  701.               SwapMem(scr, val->val.str, MALLOC_STATIC);
  702.             }
  703.             else {
  704.               /*
  705.                * If not, reset the pointer to NULL!
  706.                */
  707.               *scr->string_return = NULL;
  708.             }
  709.           }
  710.           FREE(val);
  711.         } else
  712.           end=FPLERR_OUT_OF_MEMORY;
  713.  
  714.         if(end>FPL_EXIT_OK) {
  715.           struct fplArgument pass={
  716.             NULL, FPL_GENERAL_ERROR, NULL, 0};
  717.           void *array[1];
  718.           pass.key=(void *)scr;
  719.           array[0] = (void *)end;
  720.           pass.argv= array;
  721.  
  722.           if(scr->error) {
  723.         /* We'll fix the error string! */
  724.         GetErrorMsg(scr, end, scr->error);
  725.       }
  726.  
  727.           /* new argv assigning for OS/2 compliance! */
  728.           InterfaceCallNoStack(scr, &pass, scr->function);
  729.         }
  730.  
  731.         thisprog->column=scr->text-(&thisprog->program)[scr->prg-1]+1;
  732.         scr->virfile=NULL; /* most likely to not point to anything decent
  733.                               anyway! */
  734.  
  735.         /*
  736.          * Go through the ENTIRE locals list and delete all. Otherwise they will
  737.          * ruin the symbol table.
  738.          */
  739.  
  740.         while(scr->locals)
  741.           DelLocalVar(scr, &scr->locals);
  742.  
  743.         thisprog->openings--;
  744.         LeaveProgram(scr, thisprog); /* failure is a victory anyway! */
  745.  
  746.         /*
  747.          * If the option to cache only programs exporting symbols is turned on,
  748.          * then we must check if any of the globals are exported before caching!
  749.          */
  750.  
  751.         if(end<=FPL_EXIT_OK && (storeglobals & PR_CACHEEXPORTS)) {
  752.           glob = scr->globals;
  753.  
  754.           while(glob) {
  755.             /* Traverse all global symbols */
  756.  
  757.             if(glob->ident->flags&FPL_EXPORT_SYMBOL)
  758.               /* if we found an exported symbol, get out of loop */
  759.               break;
  760.  
  761.             glob=glob->next; /* goto next global */
  762.           }
  763.  
  764.           if(!glob)
  765.             /* no exported symbols were found! */
  766.             storeglobals = FALSE; /* do not cache this file! */
  767.         }
  768.  
  769.         if(end<=FPL_EXIT_OK && storeglobals && thisprog->flags&PR_CACHEFILE) {
  770.          /* no error, store the globals and cache the file */
  771.  
  772.           if(!(thisprog->flags&PR_GLOBALSTORED)) {
  773.  
  774.             if(scr->globals) {
  775.           long total_size;
  776.           long line=1;
  777.           uchar *newprogram;
  778.               {
  779.         if(!(thisprog->flags&PR_USERSUPPLIED))
  780.           /*
  781.            * The memory is allocated by FPL itself!
  782.            */
  783.                   SwapMem(scr, thisprog->program, MALLOC_STATIC);
  784.         else {
  785.                   /*
  786.                    * The memory is allocated by the user!
  787.            */
  788.           if(thisprog->flags&PR_KIDNAP_CACHED) {
  789.             /*
  790.              * We have been instructed to "take over" all host
  791.              * allocations that we intend to keep as cached files!
  792.              */
  793.  
  794.             /* start with counting the total size of the program: */
  795.             for(line = total_size = 0; line<thisprog->lines; line++)
  796.               total_size += strlen( (&thisprog->program)[line] );
  797.  
  798.             /* get enough memory to duplicate it! */
  799.             newprogram = MALLOCA(total_size + 1 ); /* add for zero */
  800.                     newprogram[total_size] = CHAR_ASCII_ZERO;
  801.             if(newprogram) {
  802.               /*
  803.                * We got requested amount of memory to copy the entire
  804.                * user supplied program!
  805.                */
  806.                       for(line = total_size = 0; line<thisprog->lines; line++) {
  807.                         strcpy(newprogram+total_size,
  808.                    (&thisprog->program)[line]);
  809.             total_size += strlen( (&thisprog->program)[line] );
  810.               }
  811.               thisprog->program = newprogram;
  812.               thisprog->lines = 1; /* this is now in one single line! */
  813.  
  814.                       /* switch off the now incorrect bit: */
  815.               thisprog->flags &= ~PR_USERSUPPLIED;
  816.             }
  817.             else {
  818.               /* We couldn't allocate a copy of the program, fail */
  819.               line=0;
  820.               end = FPLERR_OUT_OF_MEMORY; /* fail with proper return
  821.                                              code! */
  822.             }
  823.           }
  824.         }
  825.           }
  826.           if(line) {
  827.                 /* Store all global symbols!!! */
  828.                 StoreGlobals(scr, MALLOC_STATIC); /* ignore return code */
  829.  
  830.             /* set the flag saying we did so! */
  831.                 thisprog->flags|=PR_GLOBALSTORED;
  832.           }
  833.             } else
  834.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  835.           }
  836.         } else {
  837.           /*
  838.            * We must delete the global symbol lists
  839.            * properly and not just free the memory. Otherwise we might free memory
  840.            * used in the middle of the list we intend to save for next run!
  841.            */
  842.           if(!thisprog->openings) {
  843.             /* If not in use */
  844.             if(scr->globals)
  845.             /* There is some global symbols to delete! */
  846.             DelLocalVar(scr, &scr->globals);
  847.  
  848.             /*
  849.              * Check if this program was stored in memory earlier (in
  850.              * another run). If not ...
  851.              */
  852.             if(!(thisprog->flags&PR_GLOBALSTORED)) {
  853.               /*
  854.                * ...delete this program from memory!
  855.                */
  856.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  857.             }
  858.           }
  859.         }
  860.  
  861.         if(globpointer)
  862.           *globpointer=(long)scr->globals;
  863.  
  864.         scr->runs--;
  865.       } /* else
  866.           We didn't get the program, out of memory or stupid interface
  867.           function reply!
  868.          */
  869.     } else
  870.       DelProgram(scr, prog); /* we couldn't load it! */
  871.   }
  872.  
  873.   /*
  874.    * Reset the debug mode status we had when we entered this function!
  875.    */
  876.   scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE,
  877.                          prev_mode&FPLDATA_DEBUG_MODE);
  878.   /*
  879.    * Reset the isolate status we had when we entered this function!
  880.    */
  881.   scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE,
  882.                          prev_mode&FPLDATA_ISOLATE);
  883.  
  884.   if(scr->runs) {
  885.     /* still running! */
  886.  
  887.     memcpy(&scr->text, store, sizeof(struct Store));
  888.     GetProgram(scr, scr->prog);
  889.     FREE(store);
  890.  
  891.     /* reset execute point: */
  892.     scr->text=(&scr->prog->program)[scr->prg-1]+ currcol;
  893.   }
  894.   else {
  895.     FREEALL(); /* frees all ALLOC_DYNAMIC */
  896.   }
  897.  
  898.   return(end==FPL_EXIT_OK?FPL_OK:end);
  899. }
  900.  
  901. /**********************************************************************
  902.  *
  903.  * Go();
  904.  *
  905.  * This is an own function to make the stack usage in this particular
  906.  * function very small. Then we don't have to copy more than 10-20 bytes
  907.  * of the old stack when swapping to the new in the amiga version of the
  908.  * library!
  909.  *
  910.  ******/
  911.  
  912. static ReturnCode Go(struct Data *scr, struct Expr *val)
  913. {
  914. #if defined(AMIGA) && defined(SHARED)
  915.   /* The function call below is an assembler routine that allocates a new
  916.      stack to use in the library! */
  917. #define FIRSTFUNC InitStack
  918. #else
  919.   /* Not Amiga or not shared! */
  920. #define FIRSTFUNC Script
  921. #endif
  922.  
  923.   scr->runs++;
  924.   return FIRSTFUNC(scr, val,
  925.                    SCR_BRACE|    /* to make it loop and enable declarations */
  926.                    SCR_FUNCTION| /* return on return() */
  927.                    SCR_FILE|     /* this level may end with '\0' */
  928.                    SCR_GLOBAL,   /* global symbol declarations enabled */
  929.                    NULL);
  930. }
  931.  
  932.  
  933. static ReturnCode REGARGS
  934. StoreGlobals(struct Data *scr,
  935.              uchar type)
  936. {
  937.   struct Local *local, *prev=NULL;
  938.   struct Identifier *ident;
  939.   struct fplVariable *var;
  940.  
  941.   if(scr->prog->running>1)
  942.     /*
  943.      * It's enough if we commit this only on the ground level exit!
  944.      */
  945.     return(FPL_OK);
  946.  
  947.   local=scr->globals;
  948.   while(local) {
  949.     ident=local->ident;
  950.     if(ident->flags&FPL_VARIABLE) {
  951.       SwapMem(scr, local, type);        /* preserve the chain! */
  952.       SwapMem(scr, ident, type);        /* structure */
  953.       SwapMem(scr, ident->name, type);    /* name */
  954.       var=&ident->data.variable;
  955.  
  956.       SwapMem(scr, var->var.val32, type); /* variable area */
  957.  
  958.       if(!var->num && ident->flags&FPL_STRING_VARIABLE && var->var.str[0])
  959.     /* no array but assigned string variable */
  960.     SwapMem(scr, var->var.str[0], type);    /* string */
  961.       else if(var->num) {
  962.     /* array */
  963.     SwapMem(scr, var->dims, type); /* dim info */
  964.     if(ident->flags&FPL_STRING_VARIABLE) {
  965.       int i;
  966.       for(i=0; i<var->size; i++) {
  967.         /* Take one pointer at a time */
  968.         if(var->var.str[i])
  969.           /* if the value is non-zero, it contains the allocated length
  970.          of the corresponding char pointer in the ->array->vars
  971.          array! */
  972.           SwapMem(scr, var->var.str[i], type);
  973.           }
  974.       SwapMem(scr, var->var.str, type);
  975.     }
  976.       }
  977.     } else if(ident->flags&FPL_FUNCTION) {
  978.       SwapMem(scr, local, type);        /* preserve the chain! */
  979.       SwapMem(scr, ident, type);        /* structure */
  980.       SwapMem(scr, ident->name, type);    /* name */
  981.       SwapMem(scr, ident->data.inside.format, type);    /* parameter string */
  982.     }
  983.     prev=local;
  984.     local=local->next;
  985.   }
  986.   if(prev) {
  987.     prev->next=scr->usersym; /* link in front of our previous list! */
  988.     scr->usersym=scr->globals;
  989.   }
  990.   scr->globals=NULL;
  991.   return(FPL_OK);
  992. }
  993.  
  994. /**************************************************************************
  995.  *
  996.  * int Script(struct Data *);
  997.  *
  998.  * Interprets an FPL program, very recursive. Returns progress in an integer,
  999.  * and the FPL program result code in the int scr->ret.
  1000.  * USE AS FEW VARIABLES AS POSSIBLE to spare stack usage!
  1001.  *
  1002.  **********/
  1003.  
  1004. ReturnCode ASM
  1005. Script(AREG(2) struct Data *scr,  /* big FPL structure */
  1006.        AREG(3) struct Expr *val,  /* result structure  */
  1007.        DREG(2) short control,     /* control byte */
  1008.        AREG(1) struct Condition *con)
  1009. {
  1010.   uchar declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  1011.   ReturnCode ret;           /* return value variable */
  1012.   struct Condition *con2;      /* recursive check information! */
  1013.   uchar brace=0; /* general TRUE/FALSE variable */
  1014.   uchar *text; /* position storage variable */
  1015.   long prg;   /* position storage variable */
  1016.   long levels=scr->level; /* previous level spectra */
  1017.   struct Identifier *ident; /* used when checking keywords */
  1018.   long virprg=scr->virprg;
  1019.   uchar *virfile=scr->virfile;
  1020.   uchar done=FALSE; /* TRUE when exiting */
  1021.   struct fplArgument *pass;
  1022.  
  1023. #if defined(AMIGA) && defined(SHARED)
  1024.   if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  1025.     if(ret==1)
  1026.       return(FPLERR_OUT_OF_MEMORY);
  1027.     else
  1028.       return(FPLERR_OUT_OF_STACK);
  1029.   }
  1030. #endif
  1031.  
  1032.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  1033.     /*
  1034.      * New symbol declaration level!
  1035.      */
  1036.     scr->varlevel++;
  1037.     CALL(AddLevel(scr));
  1038.   }
  1039.  
  1040.   if(control&SCR_FUNCTION)
  1041.     scr->level=0; /* number of levels to look for variables */
  1042.   else if(control&SCR_BRACE)
  1043.     scr->level++;
  1044.  
  1045.   if(scr->flags&FPLDATA_DEBUG_MODE) {
  1046.     /*
  1047.      * If debug mode is on already here, it means that our previous level
  1048.      * had it and we must make sure that they will even when we return.
  1049.      * (Without that bit, CleanUp() will switch off debug mode!)
  1050.      */
  1051.     control|=SCR_DEBUG;
  1052.   }
  1053.   while(!done) {
  1054.     if(ret=Eat(scr)) {
  1055.       if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
  1056.     /* It's OK! */
  1057.     ret=FPL_OK;
  1058.       break;
  1059.     }
  1060.  
  1061.     /* call the interval function */
  1062.     if(scr->interfunc) {
  1063.       if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  1064.     CALL(Warn(scr, FPLERR_PROGRAM_STOPPED)); /* >warning< */
  1065.     }
  1066.  
  1067. #ifdef DEBUGMAIL
  1068.     DebugMail(scr, MAIL_EXECUTE, 500, NULL);
  1069. #endif
  1070.  
  1071.     switch(*scr->text) {
  1072.     case CHAR_OPEN_BRACE:        /* open brace */
  1073.       scr->text++;
  1074.       CALL(Script(scr, val,
  1075.                   SCR_NORMAL|SCR_BRACE,
  1076.           con));
  1077.       if(CheckIt(scr, val, control, &ret)) {
  1078.     CleanUp(scr, control, levels);
  1079.     return(ret);
  1080.       }
  1081.       break;
  1082.  
  1083.     case CHAR_CLOSE_BRACE:
  1084.       if(control&SCR_LOOP) {
  1085.     if(control&SCR_BRACE) {
  1086.       DelLocalVar(scr, &scr->locals); /* delete all local declarations */
  1087.       scr->varlevel--;                /* previous variable level */
  1088.       scr->level--;           /* previous level spectra */
  1089.     }
  1090.         CALL(Loop(scr, con, control, &brace));
  1091.     if(brace) {
  1092.       /* Yes! We should loop! */
  1093.       if(control&SCR_BRACE) {
  1094.         /* bring back the proper values */
  1095.         scr->varlevel++;
  1096.         scr->level++;
  1097.         AddLevel(scr); /* restart this level! */
  1098.         declare=TRUE;
  1099.       }
  1100.       scr->virprg=virprg;
  1101.       scr->virfile=virfile;
  1102.       continue;
  1103.     }
  1104.         val->flags=0;
  1105.       } else {
  1106.     scr->text++;
  1107.         val->flags=FPL_BRACE;
  1108.     CleanUp(scr, control, levels);
  1109.       }
  1110.       scr->returnint = NULL; /* no result integer! */
  1111.       return(FPL_OK);  /* return to calling function */
  1112.  
  1113.     case CHAR_SEMICOLON:
  1114.       scr->text++;
  1115.       break;
  1116.  
  1117.     default:
  1118.       /*
  1119.        * Time to parse the statement!
  1120.        */
  1121.  
  1122.       text=scr->text;             /* store current position */
  1123.       prg=scr->prg;
  1124.       if(!Getword(scr))    /* get next word */
  1125.         GetIdentifier(scr, scr->buf, &ident);
  1126.       else {
  1127.     prg=-1;    /* we have not read a word! */
  1128.         ident=NULL;
  1129.       }
  1130.       if(ident && control&SCR_GLOBAL && declare) {
  1131.     /* still on ground level and declaration allowed */
  1132.     if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
  1133.       if(!scr->prog->foundstart) {
  1134.         /*
  1135.          * Only do this if this point isn't already known!
  1136.          * We move the pointer for the execution start position to
  1137.          * this position.
  1138.          */
  1139.         StoreBeginning(scr, text, prg);
  1140.       }
  1141.       /*
  1142.        * This is the end of the declaration phase. Now, let's
  1143.        * check for that FPLTAG_INTERPRET tag to see if we should
  1144.        * have a little fun or simply continue!
  1145.        */
  1146.       if(scr->interpret) {
  1147.             done = TRUE;
  1148.             continue;
  1149.           }
  1150.     }
  1151.       }
  1152.       if(ident && ident->flags&FPL_KEYWORD) {
  1153.     if(ident->flags&FPL_KEYWORD_DECLARE) {
  1154.       if(!declare) {
  1155.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));   /* WARNING! */
  1156.         /* declare it anyway!!! */
  1157.       }
  1158.       CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
  1159.  
  1160.     } else {
  1161.       switch(ident->data.external.ID) {
  1162.           case CMD_SWITCH:
  1163.         scr->breaks++; /* allow another level of break */
  1164.             CALL(Switch(scr, val, control, con));
  1165.             if(CheckIt(scr, val, control, &ret)) {
  1166.               CleanUp(scr, control, levels);
  1167.               return(ret);
  1168.             }
  1169.             break;
  1170.  
  1171.           case CMD_CASE:    /* 'case' */
  1172.             if(!control&SCR_SWITCH)
  1173.               return FPLERR_ILLEGAL_CASE; /* 'case' not within switch! */
  1174.             /*
  1175.              * This word can only be found if (control&SCR_SWITCH), and then
  1176.              * we must just skip the "case XX:" text and continue.
  1177.              */
  1178.             CALL(Eat(scr));
  1179.             if(scr->text[0]==CHAR_OPEN_PAREN) {
  1180.               /*
  1181.                * If this is an open parenthesis, we must search for the
  1182.                * opposite parenthesis to enable conditional statements
  1183.                * using the '?' and ':' operators.
  1184.                */
  1185.               CALL(GetEnd(scr, CHAR_CLOSE_PAREN,
  1186.                           CHAR_OPEN_PAREN, FALSE)); /* find close paren! */
  1187.             }
  1188.             if(GetEnd(scr, CHAR_COLON, 255, FALSE)) /* find colon! */
  1189.               return FPLERR_MISSING_COLON;
  1190.             if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
  1191.             /* If there was a string return, it should be freed and the
  1192.                string really held a string! */
  1193.               FREE(val->val.str);
  1194.             break;
  1195.  
  1196.           case CMD_DEFAULT: /* 'default' */
  1197.             if(!control&SCR_SWITCH)
  1198.               return FPLERR_ILLEGAL_DEFAULT; /* 'default' not within switch! */
  1199.             /*
  1200.              * This word can only be found if (control&SCR_SWITCH), and then
  1201.              * we must just skip the "default:" text and continue.
  1202.              */
  1203.             if(scr->text[0]!=CHAR_COLON) {
  1204.               if(GetEnd(scr, CHAR_COLON, 255, FALSE))
  1205.                 return FPLERR_MISSING_COLON;
  1206.             } else
  1207.               scr->text++;
  1208.             break;
  1209.  
  1210.       case CMD_TYPEDEF:
  1211.         CALL(Getword(scr));
  1212.         CALL(GetIdentifier(scr, scr->buf, &ident));
  1213.         if(!ret &&
  1214.            (ident->data.external.ID==CMD_INT ||
  1215.         ident->data.external.ID==CMD_STRING)) {
  1216.           CALL(Getword(scr));
  1217.           text=(void *)ident;
  1218.           GETMEM(ident, sizeof(struct Identifier));
  1219.           *ident=*(struct Identifier *)text; /* copy entire structure! */
  1220.           GETMEM(ident->name, strlen(scr->buf)+1);
  1221.           strcpy(ident->name, scr->buf);
  1222.           ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
  1223.                                declarator symbol! */
  1224.           CALL(AddVar(scr, ident, &scr->locals));
  1225.         } else {
  1226.           CALL(Warn(scr, FPLERR_IDENTIFIER_NOT_FOUND));
  1227.           /* then just skip this statement! */
  1228.           if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  1229.                 return FPLERR_MISSING_SEMICOLON;
  1230.         }
  1231.         break;
  1232.       case CMD_RETURN:
  1233.       case CMD_EXIT:
  1234.         Eat(scr);
  1235.         scr->breaks=0; /* reset number of allowed breaks */
  1236.             scr->returnint = NULL; /* point to result */
  1237.         if(*scr->text!=CHAR_SEMICOLON) { /* no return */
  1238.           brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
  1239.           scr->text+=brace;
  1240.  
  1241.           /*
  1242.            * If return()ing from a function when scr->strret is TRUE,
  1243.            * return a string.
  1244.            */
  1245.           if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
  1246.                  (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
  1247.         CALL(Expression(val, scr, CON_NORMAL, NULL));
  1248.         if(!(val->flags&FPL_STRING)) {
  1249.           /* that wasn't a string! */
  1250.           CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1251.         } else {
  1252.           /* It was a string! */
  1253.           if(val->flags&FPL_NOFREE) {
  1254.             /*
  1255.              * We're only refering to another string! We can't
  1256.              * allow that since that string might be a local
  1257.              * variable, and all such are about to be deleted now!
  1258.              */
  1259.             struct fplStr *string;
  1260.                     if(val->val.str) {
  1261.                       /* did we really get a pointer? */
  1262.               GETMEM(string, val->val.str->len+sizeof(struct fplStr));
  1263.               memcpy(string,
  1264.                  val->val.str,
  1265.                  val->val.str->len+sizeof(struct fplStr));
  1266.               string->alloc=val->val.str->len;
  1267.                     }
  1268.                     else {
  1269.                       GETMEM(string, sizeof(struct fplStr));
  1270.                       string->len = string->alloc = 0;
  1271.                     }
  1272.             val->val.str=string;
  1273.             val->flags&=~FPL_NOFREE;
  1274.           }
  1275.         }
  1276.  
  1277.           } else {
  1278.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1279.                 scr->returnint = &scr->FPLret; /* point to result */
  1280.           }
  1281.           if(brace)
  1282.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1283.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1284.           /* continue */
  1285.         } else
  1286.           scr->text++;
  1287.         } else {
  1288.           val->val.val=0;
  1289.           val->flags=0;
  1290.         }
  1291.         scr->FPLret=val->val.val;    /* set return code! */
  1292.         if(ident->data.external.ID==CMD_RETURN) {
  1293.           ret=FPL_OK;
  1294.         } else
  1295.           ret=FPL_EXIT_OK; /* This will make us return through it all! */
  1296.  
  1297.             val->flags|=FPL_RETURN; /* inform calling function */
  1298.  
  1299.         CleanUp(scr, control, levels);
  1300.         return(ret);
  1301.       case CMD_IF:        /* if() */
  1302.       case CMD_WHILE:    /* while() */
  1303.         Eat(scr);
  1304.  
  1305.         /*********************
  1306.  
  1307.           PARSE CONDITION
  1308.  
  1309.           *******************/
  1310.  
  1311.  
  1312.         if(*scr->text!=CHAR_OPEN_PAREN) {
  1313.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1314.           /* please, go on! */
  1315.         } else
  1316.           scr->text++;
  1317.  
  1318.         GETMEM(con2, sizeof(struct Condition));
  1319.  
  1320.         /* save check position! */
  1321.         con2->check=scr->text;
  1322.         con2->checkl=scr->prg;
  1323.  
  1324.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1325.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1326.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1327.           /* continue */
  1328.         } else
  1329.           scr->text++;
  1330.  
  1331.         if(val->val.val) {
  1332.           /********************
  1333.  
  1334.         PARSE STATMENT
  1335.  
  1336.         ******************/
  1337.  
  1338.           Eat(scr);
  1339.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1340.           con2->bracetext=scr->text;
  1341.           con2->braceprg=scr->prg;
  1342.  
  1343.           if(CMD_WHILE == ident->data.external.ID)
  1344.         scr->breaks++; /* yet another break level */
  1345.           CALL(Script(scr, val,
  1346.               (brace?SCR_BRACE:0)|
  1347.               (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF),
  1348.               con2));
  1349.           if(CheckIt(scr, val, control, &ret)) {
  1350.         FREE(con2);
  1351.         CleanUp(scr, control, levels);
  1352.         return(ret);
  1353.           }
  1354.           brace=TRUE;
  1355.         } else {
  1356.           /********************
  1357.  
  1358.         SKIP STATEMENT
  1359.  
  1360.         ******************/
  1361.  
  1362.           CALL(SkipStatement(scr));
  1363.           brace=FALSE;
  1364.         }
  1365.  
  1366.             Eat(scr); /* we must eat space before storing the position,
  1367.                          otherwise we might eat newlines several times! */
  1368.             
  1369.         text=scr->text;
  1370.         prg=scr->prg;
  1371.  
  1372.         Getword(scr);
  1373.  
  1374.         if(!strcmp(KEYWORD_ELSE, scr->buf) && brace) {
  1375.           /********************
  1376.  
  1377.         SKIP STATEMENT
  1378.  
  1379.         ******************/
  1380.  
  1381.           CALL(SkipStatement(scr));
  1382.         } else if(!strcmp(KEYWORD_ELSE, scr->buf) && !brace) {
  1383.           /********************
  1384.  
  1385.         PARSE STATMENT
  1386.  
  1387.         ******************/
  1388.  
  1389.           Eat(scr);
  1390.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1391.           con2->bracetext=scr->text;
  1392.           con2->braceprg=scr->prg;
  1393.           CALL(Script(scr, val, (brace?SCR_BRACE:0), con2));
  1394.           if(CheckIt(scr, val, control, &ret)) {
  1395.         FREE(con2);
  1396.         CleanUp(scr, control, levels);
  1397.         return(ret);
  1398.           }
  1399.         } else {
  1400.           scr->text=text;
  1401.           scr->prg=prg;
  1402.         }
  1403.         FREE(con2);
  1404.         break;
  1405.       case CMD_BREAK:
  1406.         val->val.val=1;    /* default is break 1 */
  1407.         val->flags=0;    /* reset flags */
  1408.         CALL(Eat(scr));
  1409.         /*
  1410.          * Check if break out of several statements.
  1411.          */
  1412.         if(*scr->text!=CHAR_SEMICOLON) {
  1413.           /* Get the result of the expression. */
  1414.           brace=*scr->text==CHAR_OPEN_PAREN;
  1415.           scr->text+=brace;
  1416.           CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1417.           if(brace)
  1418.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1419.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1420.         } else
  1421.           scr->text++;
  1422.           else if(val->val.val<0) {
  1423.         CALL(Warn(scr, FPLERR_ILLEGAL_BREAK));
  1424.         val->val.val=1; /* reset! */
  1425.           }
  1426.         }
  1427.         /*
  1428.          * Check that the requested number of break levels is possible
  1429.          * to break out from!
  1430.          */
  1431.         if(scr->breaks < val->val.val)
  1432.           return FPLERR_ILLEGAL_BREAK;
  1433.  
  1434.         /*
  1435.          * Go to end of statement!!! If this was started without
  1436.          * SCR_BRACE set, we're already at the end of the statement!
  1437.          */
  1438.         if(control&SCR_BRACE) {
  1439.           if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1440.                 return FPLERR_MISSING_BRACE;
  1441. #ifdef DEBUG_BREAKS
  1442.           fprintf(stderr, "First: levels %d line %d, brace? %d bl: %d\n",
  1443.               val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  1444.               scr->breaks);
  1445. #endif
  1446.             }
  1447.         if(control&SCR_DO)
  1448.           /* if it was inside a do statement, pass the ending `while' */
  1449.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  1450.         val->flags|=FPL_BREAK;
  1451.         if(control&(SCR_LOOP)) {
  1452.           scr->breaks--; /* decrease break level counter */
  1453.           if(!--val->val.val)
  1454.         val->flags&=~FPL_BREAK; /* only this break! */
  1455.         }
  1456.         CleanUp(scr, control, levels);
  1457.         return(FPL_OK);
  1458.       case CMD_CONTINUE:
  1459.         if(*scr->text!=CHAR_SEMICOLON) {
  1460.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));  /* >warning< */
  1461.         } else
  1462.           scr->text++;
  1463.         if(! scr->breaks)
  1464.           return FPLERR_ILLEGAL_CONTINUE;
  1465.         if(control&SCR_LOOP) {
  1466.  
  1467.           if(control&SCR_BRACE) {
  1468.         DelLocalVar(scr, &scr->locals); /* delete all locals */
  1469.         scr->varlevel--;                /* previous variable level */
  1470.         scr->level--;                     /* previous level spectra */
  1471.           }
  1472.  
  1473.           /* loop! */
  1474.           CALL(Loop(scr, con, control, &brace));
  1475.           if(!brace) {
  1476.         /*
  1477.          * The result of the condition check was FALSE. Move to the end
  1478.          * of the block and continue execution there!
  1479.          */
  1480.  
  1481.         if(control&SCR_BRACE) {
  1482.           /* braces */
  1483.           if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1484.                     return FPLERR_MISSING_BRACE;
  1485.         }
  1486.         val->flags=0;
  1487.           } else {
  1488.         if(control&SCR_BRACE) {
  1489.           /* bring back the proper values */
  1490.           scr->varlevel++;
  1491.           scr->level++;
  1492.           AddLevel(scr); /* restart this level! */
  1493.           declare=TRUE;
  1494.         }
  1495.         scr->virprg=virprg;
  1496.         scr->virfile=virfile;
  1497.         continue;
  1498.           }
  1499.         } else {
  1500.           /* it's no looping statement! */
  1501.  
  1502.           if(control&SCR_BRACE) {
  1503.         /* braces */
  1504.         if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1505.           return FPLERR_MISSING_BRACE;
  1506.           }
  1507.           val->flags=FPL_CONTINUE;
  1508.           CleanUp(scr, control, levels);
  1509.         }
  1510.         return(FPL_OK);
  1511.       case CMD_DO:
  1512.         CALL(Eat(scr));
  1513.         GETMEM(con2, sizeof(struct Condition));
  1514.         scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1515.         con2->bracetext=scr->text;
  1516.         con2->braceprg=scr->prg;
  1517.         con2->check=NULL;
  1518.         scr->breaks++; /* increase break level */
  1519.         CALL(Script(scr, val, SCR_DO|(brace?SCR_BRACE:0), con2));
  1520.         FREE(con2);
  1521.         if(CheckIt(scr, val, control, &ret)) {
  1522.           CleanUp(scr, control, levels);
  1523.           return(ret);
  1524.         }
  1525.         break;
  1526.       case CMD_FOR:
  1527.         Eat(scr);
  1528.         scr->text++;
  1529.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));
  1530.  
  1531.         if(*scr->text!=CHAR_SEMICOLON) {
  1532.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1533.         } else
  1534.           scr->text++;
  1535.         GETMEM(con2, sizeof(struct Condition));
  1536.  
  1537.         con2->check=scr->text;
  1538.         con2->checkl=scr->prg;
  1539.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));
  1540.  
  1541.         if(*scr->text!=CHAR_SEMICOLON) {
  1542.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1543.         } else
  1544.           scr->text++;
  1545.         con2->postexpr=scr->text;
  1546.         con2->postexprl=scr->prg;
  1547.             {
  1548.           /*
  1549.            * Pass the last expression:
  1550.            */
  1551.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
  1552.         }
  1553.         if(!val->val.val) {
  1554.           /* We shouldn't enter the loop! Go to end of block:*/
  1555.           CALL(SkipStatement(scr));
  1556.           FREE(con2);
  1557.         } else {
  1558.           CALL(Eat(scr));
  1559.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1560.           con2->bracetext=scr->text;
  1561.           con2->braceprg=scr->prg;
  1562.           scr->breaks++; /* increase break level */
  1563.           CALL(Script(scr, val, (brace?SCR_BRACE:0)|SCR_FOR, con2));
  1564.           FREE(con2);
  1565.           if(CheckIt(scr, val, control, &ret)) {
  1566.         CleanUp(scr, control, levels);
  1567.         return(ret);
  1568.           }
  1569.         }
  1570.         break;
  1571.       case CMD_RESIZE:
  1572.         CALL(Resize(scr, val, control));
  1573.         break;
  1574.       } /* switch(keyword) */
  1575.         } /* if it wasn't a declaring keyword */
  1576.       } else {
  1577.     declare=FALSE;
  1578.     CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
  1579. #if 0
  1580.     /*
  1581.      * First check for 'action' in the parsed statement!
  1582.          */
  1583.         if(!(val->flags&FPL_ACTION)) {
  1584.       /*
  1585.        * No 'action' !
  1586.        */
  1587.           CALL(Warn(scr, FPLERR_NO_ACTION));
  1588.           /* but we can just as good keep on anyway! */
  1589.         }
  1590. #endif
  1591.     /*
  1592.      * It it returned a string, flush it!
  1593.      */
  1594.     if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str) {
  1595.       /* If there was a string return, it should be freed and the
  1596.          string really held a string! */
  1597.       FREE(val->val.str);
  1598.     }
  1599.     /*
  1600.      * Check for semicolon!
  1601.      */
  1602.     if(*scr->text!=CHAR_SEMICOLON) {
  1603.       CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1604.     } else
  1605.       scr->text++;
  1606.       }
  1607.     } /* switch (*scr->text) */
  1608.  
  1609.     if(!(control&(SCR_BRACE|SCR_SWITCH))) {
  1610.       if(control&SCR_LOOP) {
  1611.     CALL(Loop(scr, con, control, &brace));
  1612.     if(brace) {
  1613.       /* Yes! We should loop! */
  1614.       if(control&SCR_BRACE) {
  1615.         /* bring back the proper values */
  1616.         scr->varlevel++;
  1617.         scr->level++;
  1618.         AddLevel(scr); /* restart this level! */
  1619.         declare=TRUE;
  1620.       }
  1621.       scr->virprg=virprg;
  1622.       scr->virfile=virfile;
  1623.       continue;
  1624.     }
  1625.     val->flags=0;
  1626.     ret=FPL_OK;
  1627.     break; /* return to calling function */
  1628.       } else
  1629.     break;
  1630.     }
  1631.   } /* loop! */
  1632.  
  1633.   if(!ret &&
  1634.      control&SCR_FILE &&
  1635.      !scr->prog->foundstart &&
  1636.      !done) {
  1637.     /*
  1638.      * We did get here by hitting end of program.
  1639.      * Let's set the start-of-main position right here to
  1640.      * make another run work fine on this file too!
  1641.      */
  1642.     StoreBeginning(scr, scr->text, scr->prg);
  1643.   }
  1644.  
  1645.   /*
  1646.    * Check for that FPLTAG_INTERPRET tag!
  1647.    */
  1648.   if(!ret && scr->interpret) {
  1649.     /* an alternative main program is specified */
  1650.     GETMEM(pass, sizeof(struct fplArgument));
  1651.     pass->ID=FNC_INTERPRET;
  1652.     text = scr->interpret;
  1653.     pass->argv=(void **)&text;
  1654.     pass->key=scr;
  1655.     scr->interpret=NULL; /* disable recursion! */
  1656.     CALL(functions(pass));
  1657.  
  1658.     CleanUp(scr, control, levels);
  1659.  
  1660.     /* we're done for this time, exit! */
  1661.     ret = FPL_EXIT_OK;
  1662.   }
  1663.  
  1664.   CleanUp(scr, control, levels);
  1665.   return(ret);
  1666. }
  1667.  
  1668. static REGARGS void
  1669. StoreBeginning(struct Data *scr, char *text, long prg)
  1670. {
  1671.   scr->prog->startcol=text-(&scr->prog->program)[prg-1];
  1672.   scr->prog->startprg=prg;
  1673.   scr->prog->virprg=scr->virprg;
  1674.   scr->prog->virfile=scr->virfile;
  1675.   scr->prog->foundstart=TRUE;
  1676.  
  1677.   /* fprintf(stderr, "Setexp:%s", text); */
  1678. }
  1679.  
  1680. static ReturnCode INLINE
  1681. Switch(struct Data *scr,
  1682.        struct Expr *val,
  1683.        short control,
  1684.        struct Condition *con)
  1685. {
  1686.   ReturnCode ret;
  1687.   struct fplStr *string;
  1688.   long value;
  1689.   uchar strtype=FALSE;
  1690.   uchar breakout=FALSE;
  1691.  
  1692.   /* temporary storage variables */
  1693.   uchar *ttext;
  1694.   long tprg;
  1695.   uchar *tvirfile;
  1696.   long tvirprg;
  1697.  
  1698.   uchar end=FALSE; /* we have not found the end position */
  1699.  
  1700.   long bprg;
  1701.   uchar *btext;
  1702.   long bvirprg;
  1703.   uchar *bvirfile;
  1704.  
  1705.   long dprg=-1;
  1706.   uchar *dtext;
  1707.   long dvirprg;
  1708.   uchar *dvirfile;
  1709.  
  1710.   CALL(Eat(scr)); /* eat whitespace */
  1711.  
  1712.   /* Check the open parenthesis */
  1713.   if(scr->text[0]!=CHAR_OPEN_PAREN) {
  1714.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1715.   } else
  1716.     scr->text++;
  1717.  
  1718.   /* Get expression, string or int, static or dynamic! */
  1719.   CALL(Expression(val, scr, CON_NORMAL, NULL));
  1720.  
  1721.   if(val->flags&FPL_STRING) {
  1722.     /* there was a string statement! */
  1723.     string = val->val.str;
  1724.     if(string)
  1725.       strtype=2;
  1726.     else
  1727.       strtype= 1;
  1728.  
  1729.   } else {
  1730.     /* there was an integer expression */
  1731.     value = val->val.val;
  1732.   }
  1733.  
  1734.   /* Check the close parenthesis */
  1735.   if(scr->text[0]!=CHAR_CLOSE_PAREN) {
  1736.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1737.   } else
  1738.     scr->text++;
  1739.  
  1740.   CALL(Eat(scr)); /* eat whitespace */
  1741.  
  1742.   /* Check the open brace */
  1743.   if(scr->text[0]!=CHAR_OPEN_BRACE) {
  1744.     CALL(Warn(scr, FPLERR_MISSING_BRACE)); /* >warning< */
  1745.   } else
  1746.     scr->text++;
  1747.  
  1748.   while(!(ret=Eat(scr))) {
  1749.     tprg = scr->prg;
  1750.     ttext = scr->text;
  1751.     tvirprg = scr->virprg;
  1752.     tvirfile = scr->virfile;
  1753.     if(!Getword(scr)) {
  1754.       if(!strcmp("case", scr->buf)) {
  1755.         /* This is a valid case-line coming up! */
  1756.  
  1757.         /* Get expression, string or int! */
  1758.         CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
  1759.         if(strtype) {
  1760.           /*
  1761.            * String comparison:
  1762.            */
  1763.           value = val->val.str?val->val.str->len:0;
  1764.  
  1765.           if(value == (string?string->len:0)) {
  1766.  
  1767.             if(value) {
  1768.               if(!memcmp(val->val.str->string, string->string, value)) {
  1769.                 /* match! */
  1770.                 breakout=TRUE;
  1771.               }
  1772.             } else
  1773.               breakout=TRUE;
  1774.           }
  1775.           if(!val->flags&FPL_NOFREE)
  1776.             FREE(val->val.str);
  1777.           if(breakout)
  1778.             break;
  1779.           else
  1780.             scr->text++; /* pass the ';' */
  1781.         } else {
  1782.           /*
  1783.            * Integer comparison:
  1784.            */
  1785.           if(val->val.val == value) {
  1786.             breakout = TRUE;
  1787.             break;
  1788.           } else
  1789.             scr->text++; /* pass the ';' */
  1790.         }
  1791.       } else if(!strcmp("default", scr->buf)) {
  1792.         /*
  1793.          * Store the default position to make it possible to return to if
  1794.          * necessary!
  1795.          */
  1796.  
  1797.     if(dprg>=0)
  1798.       return FPLERR_ILLEGAL_DEFAULT; /* dual 'default' specified! */
  1799.  
  1800.         dprg = scr->prg;
  1801.         dtext = scr->text++; /* pass the colon after the assign */
  1802.         dvirprg = scr->virprg;
  1803.         dvirfile = scr->virfile;
  1804.  
  1805.       } else {
  1806.         /*
  1807.          * Pass the statement!
  1808.          */
  1809.  
  1810.         /* First, restore the previuos position so that we can skip
  1811.            if, while, do and such things without problems! */
  1812.         scr->prg=tprg;
  1813.         scr->text=ttext;
  1814.         scr->virprg=tvirprg;
  1815.         scr->virfile=tvirfile;
  1816.  
  1817.         CALL(SkipStatement(scr));
  1818.       }
  1819.     } else {
  1820.       /* we didn't get any word */
  1821.       if(scr->text[0]==CHAR_CLOSE_BRACE) {
  1822.         /*
  1823.          * We hit the end without finding our 'case'! Return to the
  1824.          * 'default', if any! Store the position to be able to quickly
  1825.          * jump down to it again after the possible case-statement.
  1826.          */
  1827.  
  1828.         scr->text++; /* pass the closing brace */
  1829.         if(dprg<0)
  1830.           /* we didn't find any 'default' */
  1831.           break;
  1832.         bprg = scr->prg;
  1833.         btext = scr->text;
  1834.         bvirprg = scr->virprg;
  1835.         bvirfile = scr->virfile;
  1836.  
  1837.         end=TRUE; /* we have found the end! */
  1838.  
  1839.         scr->prg=dprg;
  1840.         scr->text=dtext;
  1841.         scr->virprg=dvirprg;
  1842.         scr->virfile=dvirfile;
  1843.         breakout = TRUE;
  1844.         break;
  1845.  
  1846.       } else {
  1847.         /*
  1848.          * Pass the statement!
  1849.          */
  1850.         CALL(SkipStatement(scr));
  1851.       }
  1852.     }
  1853.   }
  1854.   if(breakout) {
  1855.     /* we did break out on any of the 'case' or 'default' label lines,
  1856.        pass the colon!
  1857.      */
  1858.     /* CALL(Eat(scr));  eating whitespace shouldn't be necessary here */
  1859.  
  1860.     /* Check the colon */
  1861.     if(scr->text[0]!=CHAR_COLON) {
  1862.       CALL(Warn(scr, FPLERR_MISSING_COLON)); /* missing colon */
  1863.     } else
  1864.       scr->text++;
  1865.  
  1866.     /*
  1867.      * run this statement all the way until break or '}'!
  1868.      */
  1869.  
  1870.     CALL(Script(scr, val, SCR_SWITCH, con));
  1871.  
  1872.     if(!(val->flags&FPL_BRACE)) {
  1873.       /* we didn't run into the closing brace! */
  1874.  
  1875.       if(val->flags&FPL_BREAK) {
  1876.         /*
  1877.          * We got here after hitting a 'break' !!
  1878.          */
  1879.         scr->breaks--; /* decrease break level counter */
  1880.         if(!--val->val.val)
  1881.           val->flags&=~FPL_BREAK; /* only this break and no more ! */
  1882.       }
  1883.  
  1884.       /*
  1885.        * Go to the end of the switch()-statement.
  1886.        */
  1887.       if(!end) {
  1888.         /* we'll have to search for it! */
  1889.         if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1890.           return FPLERR_MISSING_BRACE;
  1891.       } else {
  1892.         scr->prg=bprg;
  1893.         scr->text=btext;
  1894.         scr->virprg=bvirprg;
  1895.         scr->virfile=bvirfile;
  1896.       }
  1897.     }
  1898.  
  1899.   }
  1900.   return ret;
  1901. }
  1902.  
  1903. static ReturnCode INLINE
  1904. Declare(struct Expr *val,
  1905.     struct Data *scr,
  1906.     struct Identifier *ident,
  1907.     long start)            /* start flags */
  1908. {
  1909.   ReturnCode ret;
  1910.   long flags=start;
  1911.   do {
  1912.     switch(ident->data.external.ID) {
  1913.     case CMD_EXPORT:
  1914.       if(!(scr->flags&FPLDATA_ISOLATE))
  1915.         /* don't do this while running in isolate mode! */
  1916.         flags|=CON_DECLEXP;
  1917.       break;
  1918.     case CMD_STRING:
  1919.       flags|=CON_DECLSTR;
  1920.       break;
  1921.     case CMD_INT:
  1922.       flags|=CON_DECLINT;
  1923.       if(ident->flags&FPL_SHORT_VARIABLE)
  1924.     flags|=CON_DECL16;
  1925.       else if(ident->flags&FPL_CHAR_VARIABLE)
  1926.     flags|=CON_DECL8;
  1927.       break;
  1928.     case CMD_VOID:
  1929.       flags|=CON_DECLVOID;
  1930.       break;
  1931.     case CMD_AUTO:
  1932.     case CMD_REGISTER:
  1933.       /* flags&=~(CON_DECLEXP|CON_DECLGLOB); */
  1934.       break;
  1935.     case CMD_CONST:
  1936.       flags|=CON_DECLCONST;
  1937.       break;
  1938.     case CMD_STATIC:
  1939.       flags|=CON_DECLSTATIC;
  1940.       break;
  1941.     }
  1942.     CALL(Getword(scr));
  1943.     ret=GetIdentifier(scr, scr->buf, &ident);
  1944.   } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);
  1945.  
  1946.   if(!(flags&CON_DECLARE))
  1947.     flags|=CON_DECLINT; /* integer declaration is default! */
  1948.  
  1949.   CALL(Expression(val, scr, CON_GROUNDLVL|flags|CON_IDENT, ident));
  1950.   if(*scr->text!=CHAR_SEMICOLON &&
  1951.      (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) {
  1952.     CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1953.   } else
  1954.     scr->text++;
  1955.   return(FPL_OK);
  1956. }
  1957.  
  1958.  
  1959.  
  1960. /**********************************************************************
  1961.  *
  1962.  * Resize()
  1963.  *
  1964.  * This function resizes a variable array to the new given size.
  1965.  *
  1966.  *****/
  1967.  
  1968. static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, uchar control)
  1969. {
  1970.   uchar num=0; /* number of dimensions */
  1971.   long *dims; /* dimension array */
  1972.   struct fplVariable *var;
  1973.   struct Identifier *ident;
  1974.   ReturnCode ret;
  1975.   CALL(Getword(scr));
  1976.   CALL(GetIdentifier(scr, scr->buf, &ident));
  1977.   var=&ident->data.variable;
  1978.  
  1979.   if(!(ident->flags&FPL_VARIABLE) || !var->num) {
  1980.     return FPLERR_ILLEGAL_RESIZE;
  1981.   }
  1982.  
  1983.   Eat(scr);
  1984.   GETMEM(dims, MAX_DIMS*sizeof(long));
  1985.  
  1986.   do {
  1987.     if(*scr->text!=CHAR_OPEN_BRACKET) {
  1988.       CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  1989.     } else
  1990.       scr->text++; /* pass the open bracket */
  1991.     /* eval the expression: */
  1992.     CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1993.     if(*scr->text++!=CHAR_CLOSE_BRACKET)
  1994.       /* no close bracket means error */
  1995.       return(FPLERR_MISSING_BRACKET); /* missing bracket */
  1996.     else if(val->val.val<(control&CON_DECLARE?1:0)) {
  1997.       /* illegal result of the expression */
  1998.       /*
  1999.        * Set back original variable name!
  2000.        */
  2001.       strcpy(scr->buf, ident->name);
  2002.       return(FPLERR_ILLEGAL_ARRAY);
  2003.     }
  2004.     dims[num++]=val->val.val; /* Add another dimension */
  2005.     if(num==MAX_DIMS) {
  2006.       /* if we try to declare too many dimensions... */
  2007.       /*
  2008.        * Set back original variable name!
  2009.        */
  2010.       strcpy(scr->buf, ident->name);
  2011.       return FPLERR_ILLEGAL_ARRAY;
  2012.     }
  2013.     /*
  2014.      * Go on as long there are brackets,
  2015.      */
  2016.   } while(*scr->text==CHAR_OPEN_BRACKET);
  2017.  
  2018.   CALL(ArrayResize(scr, num, dims, ident));
  2019.  
  2020.   FREE(dims);
  2021.   return(FPL_OK);
  2022. }
  2023.  
  2024.  
  2025. ReturnCode REGARGS
  2026. ArrayResize(struct Data *scr,
  2027.             long num,   /* number of new dimensions */
  2028.             long *dims, /* array of new dim sizes */
  2029.             struct Identifier *ident) /* _valid_ variable to resize */
  2030. {
  2031.   long size;
  2032.   long i;
  2033.   long min;
  2034.   void *tempvars;
  2035.   struct fplVariable *var;
  2036.   uchar dynamic=FALSE;
  2037.   var=&ident->data.variable;
  2038.   
  2039.   size=dims[0]; /* array size */
  2040.   for(i=1; i<num; i++)
  2041.     size*=dims[i];
  2042.  
  2043.   min=MIN(size, var->size); /* number of variables to copy! */
  2044.  
  2045.   if(MALLOC_DYNAMIC == TypeMem(ident)) {
  2046.     dynamic = TRUE;
  2047.     GETMEM(tempvars, size * sizeof(void *)); /* data adjust! */
  2048.   }
  2049.   else {
  2050.     GETMEMA(tempvars, size * sizeof(void *)); /* data adjust! */
  2051.   }
  2052.   memcpy(tempvars, var->var.str, min * sizeof(void *));
  2053.   if(size>var->size)
  2054.     /*
  2055.      * If we create a few more than before, empty that data!
  2056.      */
  2057.     memset((uchar *)tempvars+var->size*sizeof(void *), 0,
  2058.        (size-var->size)*sizeof(void *));
  2059.  
  2060.   if(ident->flags&FPL_STRING_VARIABLE)
  2061.     for(i=min; i<var->size; i++) {
  2062.       if(var->var.str[i]) {
  2063.     FREE_KIND(var->var.str[i]);
  2064.       }
  2065.     }
  2066.  
  2067.   FREE_KIND(var->var.val);
  2068.   var->var.val= tempvars;
  2069.  
  2070.   var->size= size;
  2071.   var->num = num;
  2072.   FREE_KIND(var->dims);
  2073.   if(dynamic) {
  2074.     GETMEM(var->dims, num * sizeof(long));
  2075.   }
  2076.   else {
  2077.     GETMEMA(var->dims, num * sizeof(long));
  2078.   }
  2079.   memcpy(var->dims, dims, num * sizeof(long));
  2080.  
  2081.   return FPL_OK;
  2082. }
  2083.  
  2084. /**********************************************************************
  2085.  *
  2086.  * char CheckIt()
  2087.  *
  2088.  * Returns wether we should return from this Script().
  2089.  *
  2090.  *****/
  2091.  
  2092. static uchar REGARGS
  2093. CheckIt(struct Data *scr, /* major script structure */
  2094.         struct Expr *val, /* result structure */
  2095.         short control,    /* control defines */
  2096.         ReturnCode *ret)  /* return code pointer */
  2097. {
  2098.   if(val->flags&FPL_BREAK) {
  2099.     /*
  2100.      * A `break' was hit inside that Script() invoke.
  2101.      */
  2102.     if(control&SCR_BRACE) {
  2103.       /*
  2104.        * If we're inside braces, search for the close brace!
  2105.        */
  2106.       if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2107.     *ret = FPLERR_ILLEGAL_BREAK;
  2108.     return((uchar)*ret);
  2109.       }
  2110.     }
  2111. #ifdef DEBUG_BREAKS
  2112.     fprintf(stderr, "EOS: levels %d line %d, brace? %d bl: %d\n",
  2113.         val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  2114.         scr->breaks);
  2115. #endif
  2116.  
  2117.     if(control&(SCR_LOOP)) {
  2118.       scr->breaks--; /* decrease break level counter */
  2119.       if(control&SCR_DO) {
  2120.         /*
  2121.          * We're inside a do-statement! We must pass the ending "while"
  2122.          * before returning! We do it the easy way: look for the closing
  2123.          * parenthesis!
  2124.          */
  2125.     if(*ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE))
  2126.       return((uchar)*ret);
  2127.         else if(*ret = Eat(scr))
  2128.       return((uchar)*ret);
  2129.         else if(scr->text[0] != CHAR_SEMICOLON) {
  2130.           if(*ret = Warn(scr, FPLERR_MISSING_SEMICOLON))
  2131.             return((uchar)*ret);
  2132.         } else
  2133.           scr->text++; /* pass the semicolon */
  2134.       }
  2135.       if(--val->val.val<1)
  2136.     val->flags&=~FPL_BREAK; /* clear the break bit! */
  2137.       return(TRUE);
  2138.     } else if(!(control&SCR_FUNCTION))
  2139.       return(TRUE);
  2140.     else if(val->val.val<2) {
  2141.       val->flags&=~FPL_BREAK; /* clear the break bit! */
  2142.       return(FALSE); /* no more break! */
  2143.     }
  2144.     *ret=FPLERR_ILLEGAL_BREAK;
  2145.     return(TRUE);
  2146.   } else if(val->flags&FPL_RETURN)
  2147.     /* The FPL function did end in a return() */
  2148.     return(TRUE);
  2149.   else if(val->flags&FPL_CONTINUE) {
  2150.     if(control&SCR_LOOP) {
  2151.       if(control&SCR_BRACE) {
  2152.     /* If we're inside braces, search for the close brace */
  2153.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2154.           *ret = FPLERR_MISSING_BRACE;
  2155.       return((uchar)*ret);
  2156.         }
  2157.     scr->text--; /* move one step back to stand on the close brace */
  2158.     return(FALSE);
  2159.       }
  2160.     } else
  2161.       /* this is not a looping block, break out of it! */
  2162.       return(TRUE);
  2163.   }
  2164.   return(FALSE);
  2165. }
  2166.  
  2167. /**********************************************************************
  2168.  *
  2169.  * CleanUp()
  2170.  *
  2171.  * Deletes/frees all local variable information.
  2172.  *
  2173.  *******/
  2174.  
  2175. void REGARGS
  2176. CleanUp(struct Data *scr,
  2177.         long control,
  2178.         long levels)
  2179. {
  2180.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  2181.     DelLocalVar(scr, &scr->locals);
  2182.     scr->varlevel--;
  2183.     scr->level=levels; /* new variable amplitude */
  2184.   }
  2185.  
  2186.   if(!(control&SCR_DEBUG)) {
  2187.     /* previous version did not run in debug mode, switch it off! */
  2188.     scr->flags&=~FPLDATA_DEBUG_MODE;
  2189.   }
  2190. }
  2191.  
  2192.  
  2193. /**********************************************************************
  2194.  *
  2195.  * Loop()
  2196.  *
  2197.  * This function is called at the end of a block, however the block was
  2198.  * started (brace or not brace).
  2199.  *
  2200.  *******/
  2201.  
  2202. static ReturnCode REGARGS
  2203. Loop(struct Data *scr,
  2204.      struct Condition *con,
  2205.      short control,
  2206.      uchar *cont) /* store TRUE or FALSE if loop or not */
  2207. {
  2208.   ReturnCode ret = FPL_OK;
  2209.   uchar *temptext=scr->text; /* store current position */
  2210.   long temprg=scr->prg;
  2211.   struct Expr *val;
  2212.  
  2213.   GETMEM(val, sizeof(struct Expr));
  2214.  
  2215.   /*
  2216.    * First check if the block just parsed begun with a while() or for()
  2217.    * or perhaps a do in which we know the statment position!
  2218.    */
  2219.  
  2220.   if((control&SCR_WHILE ||
  2221.       control&SCR_FOR ||
  2222.       (control&SCR_DO && con->check))) {
  2223.     if(control&SCR_FOR) {     /* check if the pre keyword was for() */
  2224.       scr->text=con->postexpr;/* perform the post expression */
  2225.       scr->prg=con->postexprl;
  2226.       CALL(Expression(val, scr, CON_GROUNDLVL|CON_PAREN, NULL));
  2227.     }
  2228.     /*
  2229.      * Do the condition check. The only statement if it was a while() or
  2230.      * do while or the second statement if it was a for().
  2231.      *
  2232.      * If it was a for() as pre statement, the statement could contain
  2233.      * nothing but a semicolon and then equals TRUE.
  2234.      */
  2235.     scr->text=con->check;
  2236.     scr->prg=con->checkl;
  2237.     CALL(Expression(val, scr, CON_GROUNDLVL|
  2238.             (control&SCR_FOR?CON_SEMICOLON:0)|CON_NUM, NULL));
  2239.  
  2240.     if(val->val.val) { /* the result of the condition was true */
  2241.       scr->text=con->bracetext; /* return to the open brace */
  2242.       scr->prg=con->braceprg;
  2243.       *cont=TRUE;
  2244.       FREE(val);
  2245.       return(FPL_OK);
  2246.     }
  2247.   }
  2248.  
  2249.   if(control&SCR_DO) {
  2250.     /* This a do while end. */
  2251.  
  2252.     if(!con->check) {
  2253.       /*
  2254.        * We *DON'T* know the condition position. We have to scan forward
  2255.        * to get it!
  2256.        */
  2257.       if(*scr->text==CHAR_CLOSE_BRACE)
  2258.     /* pass the close brace */
  2259.     scr->text++;
  2260.       if(ret=Getword(scr))
  2261.     ;
  2262.       else if(strcmp(scr->buf, "while"))
  2263.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2264.       else if(ret=Eat(scr))
  2265.     ;
  2266.       else if(*scr->text++!=CHAR_OPEN_PAREN)
  2267.     ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2268.       else {
  2269.     con->check=scr->text;
  2270.     con->checkl=scr->prg;
  2271.     if(ret=Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL))
  2272.       ;
  2273.     else if(*scr->text++!=CHAR_CLOSE_PAREN)
  2274.       ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2275.       }
  2276.       if(ret)
  2277.     return(ret);
  2278.     }
  2279.     if(!val->val.val) {
  2280.       /*
  2281.        * If we had the check point up there and the condition equaled
  2282.        * FALSE. Now we have to pass the the while keyword following the
  2283.        * close brace.
  2284.        */
  2285.       scr->text=temptext;
  2286.       scr->prg=temprg;
  2287.  
  2288.       if(*scr->text==CHAR_CLOSE_BRACE)
  2289.     /* pass the close brace */
  2290.     scr->text++;
  2291.  
  2292.       if(Getword(scr) || strcmp("while", scr->buf))
  2293.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2294.       else if(GetEnd(scr, CHAR_SEMICOLON, (uchar)255, FALSE))
  2295.     ret = FPLERR_MISSING_SEMICOLON;
  2296.       if(ret)
  2297.     return(ret);
  2298.     } else {
  2299.       /* go to the open brace */
  2300.       scr->text=con->bracetext;
  2301.       scr->prg=con->braceprg;
  2302.       *cont=TRUE;
  2303.       FREE(val);
  2304.       return(FPL_OK);
  2305.     }
  2306.   }
  2307.  
  2308.   FREE(val);
  2309.  
  2310.   /*
  2311.    * The condition check has failed!
  2312.    */
  2313.  
  2314.   *cont=FALSE;
  2315.  
  2316.   if(!(control&SCR_DO)) {
  2317.     /* it's not a do-while loop */
  2318.  
  2319.     scr->text=temptext;
  2320.     scr->prg=temprg;
  2321.  
  2322.     Eat(scr);
  2323.  
  2324.     if(control&SCR_BRACE && *scr->text==CHAR_CLOSE_BRACE)
  2325.       /* pass the close brace */
  2326.       scr->text++;
  2327.   }
  2328.  
  2329.   return(ret);
  2330. }
  2331.  
  2332. /**********************************************************************
  2333.  *
  2334.  * ReturnCode SkipStatement();
  2335.  *
  2336.  *  This function should pass one statement. Statements starting with
  2337.  * "for", "do", "while" or "if" really can be meesy and in such cases
  2338.  * this function recurse extensively!!!
  2339.  *
  2340.  ******/
  2341.  
  2342. static ReturnCode REGARGS
  2343. SkipStatement(struct Data *scr)
  2344. {
  2345.   ReturnCode ret;
  2346.   struct Identifier *ident;
  2347.   CALL(Eat(scr));
  2348.  
  2349.   if(*scr->text==CHAR_SEMICOLON)
  2350.     scr->text++;
  2351.   else if(*scr->text==CHAR_OPEN_BRACE) {
  2352.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2353.       return FPLERR_MISSING_BRACE;
  2354.   } else {
  2355.     /*
  2356.      * Much more trouble this way:
  2357.      */
  2358.  
  2359.     uchar *t;
  2360.     long p;
  2361.  
  2362.     ret = Getword(scr);
  2363.     if(!ret) {
  2364.       GetIdentifier(scr, scr->buf, &ident);
  2365.       switch(ident?ident->data.external.ID:0) {
  2366.       case CMD_IF:
  2367.       case CMD_WHILE:
  2368.         Eat(scr);
  2369.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2370.         CALL(SkipStatement(scr));
  2371.     CALL(Eat(scr));
  2372.         t=scr->text;
  2373.         p=scr->prg;
  2374.  
  2375.         if(!Getword(scr) && !strcmp(KEYWORD_ELSE, scr->buf)) {
  2376.           CALL(SkipStatement(scr));
  2377.         } else {
  2378.           /*
  2379.            * Restore pointers.
  2380.            */
  2381.           scr->text=t;
  2382.           scr->prg=p;
  2383.         }
  2384.         break;
  2385.       case CMD_FOR:
  2386.       case CMD_SWITCH:
  2387.         Eat(scr);
  2388.         /* Now we must stand on an open parenthesis */
  2389.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2390.         CALL(SkipStatement(scr));
  2391.         break;
  2392.       case CMD_DO:
  2393.         Eat(scr);
  2394.         CALL(SkipStatement(scr));
  2395.  
  2396.         /*
  2397.          * The next semicolon must be the one after the
  2398.          * following `while' keyword!
  2399.          */
  2400.         if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2401.           return FPLERR_MISSING_SEMICOLON;
  2402.         break;
  2403.       default:
  2404.         ret=TRUE;
  2405.       }
  2406.     }
  2407.     if(ret) {
  2408.       /*
  2409.        * This statement ends at the next semicolon
  2410.        */
  2411.       if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2412.         return FPLERR_MISSING_SEMICOLON;
  2413.     }
  2414.   }
  2415.   return(FPL_OK);
  2416. }
  2417.  
  2418. #ifdef UNIX
  2419. long InterfaceCall(struct Data *scr,
  2420.            void *arg,
  2421.            long (*func)(void *))
  2422. {
  2423.   return func(arg);
  2424. }
  2425. #endif
  2426.